home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
lsp
/
listlib.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
10KB
|
456 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "listlib.h"
init_listlib(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
base[0]= VV[0];
(void)simple_symlispcall_no_event(VV[1],base+0,1);
MF(VV[2],L2,start,size,data);
MF(VV[3],L3,start,size,data);
MF(VV[4],L4,start,size,data);
MF(VV[5],L5,start,size,data);
MF(VV[6],L6,start,size,data);
MF(VV[7],L7,start,size,data);
MF(VV[8],L8,start,size,data);
MF(VV[9],L9,start,size,data);
MF(VV[10],L10,start,size,data);
vs_top=vs_base=base;
}
/* function definition for UNION */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
if((base[0])!=Cnil){
goto T4;}
vs_top=(vs_base=base+1)+1;
return;
T4:;
base[9]=symbol_function(VV[14]);
base[10]= car(base[0]);
base[11]= base[1];
{object V1;
V1= base[2];
vs_top=base+12;
while(!endp(V1))
{vs_push(car(V1));V1=cdr(V1);}
vs_base=base+10;}
funcall_no_event(base[9]);
vs_top=sup;
if((vs_base[0])==Cnil){
goto T7;}
base[9]= cdr(base[0]);
base[10]= base[1];
{object V2;
V2= base[2];
vs_top=base+11;
while(!endp(V2))
{vs_push(car(V2));V2=cdr(V2);}
vs_base=base+9;}
L2();
return;
T7:;
{object V3= car(base[0]);
base[10]= cdr(base[0]);
base[11]= base[1];
{object V4;
V4= base[2];
vs_top=base+12;
while(!endp(V4))
{vs_push(car(V4));V4=cdr(V4);}
vs_base=base+10;}
L2();
vs_top=sup;
base[9]= vs_base[0];
base[10]= make_cons(V3,base[9]);
vs_top=(vs_base=base+10)+1;
return;}
}
/* function definition for NUNION */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
if((base[0])!=Cnil){
goto T20;}
vs_top=(vs_base=base+1)+1;
return;
T20:;
base[9]=symbol_function(VV[14]);
base[10]= car(base[0]);
base[11]= base[1];
{object V5;
V5= base[2];
vs_top=base+12;
while(!endp(V5))
{vs_push(car(V5));V5=cdr(V5);}
vs_base=base+10;}
funcall_no_event(base[9]);
vs_top=sup;
if((vs_base[0])==Cnil){
goto T23;}
base[9]= cdr(base[0]);
base[10]= base[1];
{object V6;
V6= base[2];
vs_top=base+11;
while(!endp(V6))
{vs_push(car(V6));V6=cdr(V6);}
vs_base=base+9;}
L3();
return;
T23:;
base[10]= cdr(base[0]);
base[11]= base[1];
{object V7;
V7= base[2];
vs_top=base+12;
while(!endp(V7))
{vs_push(car(V7));V7=cdr(V7);}
vs_base=base+10;}
L3();
vs_top=sup;
base[9]= vs_base[0];
if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
(base[0])->c.c_cdr = base[9];
vs_top=(vs_base=base+0)+1;
return;
}
/* function definition for INTERSECTION */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
if((base[0])!=Cnil){
goto T36;}
base[9]= Cnil;
vs_top=(vs_base=base+9)+1;
return;
T36:;
base[9]=symbol_function(VV[14]);
base[10]= car(base[0]);
base[11]= base[1];
{object V8;
V8= base[2];
vs_top=base+12;
while(!endp(V8))
{vs_push(car(V8));V8=cdr(V8);}
vs_base=base+10;}
funcall_no_event(base[9]);
vs_top=sup;
if((vs_base[0])==Cnil){
goto T39;}
{object V9= car(base[0]);
base[10]= cdr(base[0]);
base[11]= base[1];
{object V10;
V10= base[2];
vs_top=base+12;
while(!endp(V10))
{vs_push(car(V10));V10=cdr(V10);}
vs_base=base+10;}
L4();
vs_top=sup;
base[9]= vs_base[0];
base[10]= make_cons(V9,base[9]);
vs_top=(vs_base=base+10)+1;
return;}
T39:;
base[9]= cdr(base[0]);
base[10]= base[1];
{object V11;
V11= base[2];
vs_top=base+11;
while(!endp(V11))
{vs_push(car(V11));V11=cdr(V11);}
vs_base=base+9;}
L4();
return;
}
/* function definition for NINTERSECTION */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
if((base[0])!=Cnil){
goto T52;}
base[9]= Cnil;
vs_top=(vs_base=base+9)+1;
return;
T52:;
base[9]=symbol_function(VV[14]);
base[10]= car(base[0]);
base[11]= base[1];
{object V12;
V12= base[2];
vs_top=base+12;
while(!endp(V12))
{vs_push(car(V12));V12=cdr(V12);}
vs_base=base+10;}
funcall_no_event(base[9]);
vs_top=sup;
if((vs_base[0])==Cnil){
goto T55;}
base[10]= cdr(base[0]);
base[11]= base[1];
{object V13;
V13= base[2];
vs_top=base+12;
while(!endp(V13))
{vs_push(car(V13));V13=cdr(V13);}
vs_base=base+10;}
L5();
vs_top=sup;
base[9]= vs_base[0];
if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
(base[0])->c.c_cdr = base[9];
vs_top=(vs_base=base+0)+1;
return;
T55:;
base[9]= cdr(base[0]);
base[10]= base[1];
{object V14;
V14= base[2];
vs_top=base+11;
while(!endp(V14))
{vs_push(car(V14));V14=cdr(V14);}
vs_base=base+9;}
L5();
return;
}
/* function definition for SET-DIFFERENCE */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
if((base[0])!=Cnil){
goto T68;}
base[9]= Cnil;
vs_top=(vs_base=base+9)+1;
return;
T68:;
base[9]=symbol_function(VV[14]);
base[10]= car(base[0]);
base[11]= base[1];
{object V15;
V15= base[2];
vs_top=base+12;
while(!endp(V15))
{vs_push(car(V15));V15=cdr(V15);}
vs_base=base+10;}
funcall_no_event(base[9]);
vs_top=sup;
if((vs_base[0])!=Cnil){
goto T71;}
{object V16= car(base[0]);
base[10]= cdr(base[0]);
base[11]= base[1];
{object V17;
V17= base[2];
vs_top=base+12;
while(!endp(V17))
{vs_push(car(V17));V17=cdr(V17);}
vs_base=base+10;}
L6();
vs_top=sup;
base[9]= vs_base[0];
base[10]= make_cons(V16,base[9]);
vs_top=(vs_base=base+10)+1;
return;}
T71:;
base[9]= cdr(base[0]);
base[10]= base[1];
{object V18;
V18= base[2];
vs_top=base+11;
while(!endp(V18))
{vs_push(car(V18));V18=cdr(V18);}
vs_base=base+9;}
L6();
return;
}
/* function definition for NSET-DIFFERENCE */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
if((base[0])!=Cnil){
goto T84;}
base[9]= Cnil;
vs_top=(vs_base=base+9)+1;
return;
T84:;
base[9]=symbol_function(VV[14]);
base[10]= car(base[0]);
base[11]= base[1];
{object V19;
V19= base[2];
vs_top=base+12;
while(!endp(V19))
{vs_push(car(V19));V19=cdr(V19);}
vs_base=base+10;}
funcall_no_event(base[9]);
vs_top=sup;
if((vs_base[0])!=Cnil){
goto T87;}
base[10]= cdr(base[0]);
base[11]= base[1];
{object V20;
V20= base[2];
vs_top=base+12;
while(!endp(V20))
{vs_push(car(V20));V20=cdr(V20);}
vs_base=base+10;}
L7();
vs_top=sup;
base[9]= vs_base[0];
if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
(base[0])->c.c_cdr = base[9];
vs_top=(vs_base=base+0)+1;
return;
T87:;
base[9]= cdr(base[0]);
base[10]= base[1];
{object V21;
V21= base[2];
vs_top=base+11;
while(!endp(V21))
{vs_push(car(V21));V21=cdr(V21);}
vs_base=base+9;}
L7();
return;
}
/* function definition for SET-EXCLUSIVE-OR */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
base[10]= base[0];
base[11]= base[1];
{object V22;
V22= base[2];
vs_top=base+12;
while(!endp(V22))
{vs_push(car(V22));V22=cdr(V22);}
vs_base=base+10;}
L6();
vs_top=sup;
base[9]= vs_base[0];
base[11]= base[1];
base[12]= base[0];
{object V23;
V23= base[2];
vs_top=base+13;
while(!endp(V23))
{vs_push(car(V23));V23=cdr(V23);}
vs_base=base+11;}
L6();
vs_top=sup;
base[10]= vs_base[0];
base[11]= append(base[9],base[10]);
vs_top=(vs_base=base+11)+1;
return;
}
/* function definition for NSET-EXCLUSIVE-OR */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
base[10]= base[0];
base[11]= base[1];
{object V24;
V24= base[2];
vs_top=base+12;
while(!endp(V24))
{vs_push(car(V24));V24=cdr(V24);}
vs_base=base+10;}
L6();
vs_top=sup;
base[9]= vs_base[0];
base[11]= base[1];
base[12]= base[0];
{object V25;
V25= base[2];
vs_top=base+13;
while(!endp(V25))
{vs_push(car(V25));V25=cdr(V25);}
vs_base=base+11;}
L7();
vs_top=sup;
base[10]= vs_base[0];
base[11]= nconc(base[9],base[10]);
vs_top=(vs_base=base+11)+1;
return;
}
/* function definition for SUBSETP */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
if(vs_top-vs_base<2) too_few_arguments();
parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
vs_top=sup;
base[9]= base[0];
T116:;
if((base[9])!=Cnil){
goto T117;}
base[10]= Ct;
vs_top=(vs_base=base+10)+1;
return;
T117:;
base[10]=symbol_function(VV[14]);
base[11]= car(base[9]);
base[12]= base[1];
{object V26;
V26= base[2];
vs_top=base+13;
while(!endp(V26))
{vs_push(car(V26));V26=cdr(V26);}
vs_base=base+11;}
funcall_no_event(base[10]);
vs_top=sup;
if((vs_base[0])!=Cnil){
goto T121;}
base[10]= Cnil;
vs_top=(vs_base=base+10)+1;
return;
T121:;
base[9]= cdr(base[9]);
goto T116;
}